perm filename MRSIND.LSP[MRS,LSP] blob
sn#615047 filedate 1981-09-30 generic text, type T, neo UTF8
(defun indexp (p) (let (best (score 999999)) (indexp1 p 1 0) best))
(defun indexp1 (p pos n)
(cond ((atom p) (setq p (getposp p pos) n (+ (car p) n))
(if (< n score) (setq score n best (cdr p))))
(t (do l p (cdr l) (null l)
(indexp1 (car l) (lsh pos 1) (+ n (car (getposp 'un pos))))
(setq pos (1+ (lsh pos 1)))))))
(defun getposp (p pos) (cond ((get p pos)) (t '(0))))
(defun index (p) (index1 p (ua-datum p) 1 nil))
(defun index1 (p d pos vl)
(cond ((unvarp p) (setq vl (getposv pos vl))
(do ((l vl (cdr l)))
((numberp (cadr l)) (rplaca vl (1+ (car vl)))
(rplacd l (cons d (cdr l))))
(if (eq d (car l)) (return p))))
((atom p) (setq vl (getpos p pos vl))
(do ((l (cdr vl) (cdr l)))
((numberp (car l)) (rplaca vl (1+ (car vl)))
(rplacd vl (cons d (cdr vl))))
(if (eq d (car l)) (return p))))
(t (setq vl (getposv pos vl))
(do l p (cdr l) (null l)
(index1 (car l) d (lsh pos 1) vl)
(setq pos (1+ (lsh pos 1)))))))
(defun getpos (p pos vl)
(cond ((get p pos)) (t (put p (cons 0 (getposv pos vl)) pos))))
(defun getposv (pos vl) (cond ((get 'un pos)) (t (put 'un (cons 0 vl) pos))))